home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / fcsrc.exe / FILECLRK.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-04  |  8KB  |  300 lines
  1. program FILECLRK;
  2.  
  3. {$R fc}
  4. {$D Copyright (c) 1992 by David A. Peoples}
  5. {$D Version 1.0}
  6.  
  7. uses WObjects, WinTypes, WinProcs, WinDOS, Strings, FCINI, FCDLGS;
  8.  
  9. {$I fc.inc}
  10.  
  11. const
  12.     id_FCDlgWindow    = 100;
  13.     id_FCAppLabel        = 101;
  14.     id_FCDirLabel        = 102;
  15.     id_FCFilterEdit    = 103;
  16.     id_FCFileList        = 104;
  17.  
  18.     id_FCIcon                = 200;
  19.  
  20.   cm_Select                = 101;
  21.     cm_Edit                    = 102;
  22.     cm_Quit                    = 103;
  23.     cm_HelpIndex        = 110;
  24.   cm_HelpTutorial    = 111;
  25.     cm_HelpAbout        = 112;
  26.  
  27.     id_AboutDlg            = 200;
  28.  
  29. type
  30.  
  31.     PFCDlg = ^FCDlg;
  32.     FCDlg = object(TDlgWindow)
  33.         PTranRec: PTransferRec;
  34.     FCHelpFile: array[0..fsPathName] of Char;
  35.         Choice: array[0..fsPathName] of Char;
  36.         SectionName: array[0..PrgManItm] of Char;
  37.         FCAppLabel: PStatic;
  38.         FCDirLabel: PStatic;
  39.         FCFilterEdit: PEdit;
  40.         FCFileList: PListBox;
  41.         constructor Init(AParent: PWindowsObject;
  42.             AName: PChar);
  43.     destructor Done; virtual;
  44.         procedure SetupWindow; virtual;
  45.         function GetClassName: PChar; virtual;
  46.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  47.         procedure Update;
  48.         procedure clickFCFileList(var Msg: TMessage);
  49.             virtual id_first + id_FCFileList;
  50.         procedure Ok(var Msg: TMessage);
  51.             virtual id_First + id_Ok;
  52.         procedure Launch;
  53.     procedure CMSelect(var Msg: TMessage);
  54.         virtual cm_First + cm_Select;
  55.         procedure CMEdit(var Msg: TMessage);
  56.             virtual cm_First + cm_Edit;
  57.         procedure CMQuit(var Msg: TMessage);
  58.             virtual cm_First + cm_Quit;
  59.         procedure CMHelpIndex(var Msg: TMessage);
  60.             virtual cm_First + cm_HelpIndex;
  61.     procedure CMHelpTutorial(var Msg: TMessage);
  62.         virtual cm_First + cm_HelpTutorial;
  63.         procedure CMHelpAbout(var Msg: TMessage);
  64.             virtual cm_First + cm_HelpAbout;
  65.     end;
  66.  
  67.     FCApplication = object(TApplication)
  68.         procedure InitMainWindow; virtual;
  69.     end;
  70.  
  71. { ---- FCApplication methods -------------------------------------- }
  72.  
  73. procedure FCApplication.InitMainWindow;
  74. begin
  75.     MainWindow := New(PFCDlg, Init(nil, PChar(id_FCDlgWindow)));
  76. end;
  77.  
  78.  
  79. { ---- FCDlg methods ----------------------------------------------- }
  80.  
  81. constructor FCDlg.Init(AParent: PWindowsObject; AName: PChar);
  82. var
  83.     AControl: PControl;
  84. begin
  85.     TDlgWindow.Init(AParent, AName);
  86.     FCAppLabel := New(PStatic, InitResource(@Self, id_FCAppLabel,
  87.         fsPathName+1));
  88.     FCDirLabel := New(PStatic, InitResource(@Self, id_FCDirLabel,
  89.         fsPathName+1));
  90.     FCFilterEdit := New(PEdit, InitResource(@Self, id_FCFilterEdit,
  91.         fsFileName+fsExtension+1));
  92.     FCFileList := New(PListBox, InitResource(@Self, id_FCFileList));
  93.   PTranRec := New(PTransferRec);
  94.   FillChar(PTranRec^, Sizeof(PTranRec^), #0);
  95. end;
  96.  
  97. destructor FCDlg.Done;
  98. begin
  99.     WinHelp(HWindow, FCHElpFile, HELP_QUIT, LongInt(NIL));
  100.     TDlgWindow.Done;
  101. end;
  102.  
  103. function FCDlg.GetClassName: PChar;
  104. begin
  105.     GetClassName := PChar(AppName);
  106. end;
  107.  
  108. procedure FCDlg.GetWindowClass(var AWndClass: TWndClass);
  109. begin
  110.     TDlgWindow.GetWindowClass(AWndClass);
  111.     AWndClass.HIcon := LoadIcon(HInstance, PChar(id_FCIcon));
  112. end;
  113.  
  114.  
  115. procedure FCDlg.SetupWindow;
  116. var
  117.     Buffer: array[0..fsPathName] of Char;
  118.   Temp1: array[0..fsFileName] of Char;
  119.   Temp2: array[0..fsExtension] of Char;
  120. begin
  121.     TDlgWindow.SetupWindow;
  122.   StrPCopy(Buffer, ParamStr(0));
  123.   FileSplit(Buffer, FCHelpFile, Temp1, Temp2);
  124.   if FCHelpFile[3] = #0 then FCHelpFile[2] := #0;
  125.   StrCat(FCHelpFile, '\');
  126.   StrCat(FCHelpFile, HelpName);
  127.     if ParamCount > 0 then
  128.   begin
  129.         StrPCopy(Buffer, ParamStr(1));
  130.     StrLCopy(SectionName, Buffer, Sizeof(SectionName)-1);
  131.   end
  132.     else
  133.         StrCopy(SectionName, '_DEFAULT');
  134.     GetIniData(PTranRec, SectionName);
  135.     Update;
  136. end;
  137.  
  138. procedure FCDlg.Update;
  139. var
  140.     Title: array[0..MTitleLen] of Char;
  141.   ShortApp, Scratch: array[0..fsPathName] of Char;
  142.   P: PChar;
  143.   L: Integer;
  144. begin
  145.     StrCopy(Scratch, SectionName);
  146.   if StrLen(Scratch) > MTitleLen-16 then
  147.   begin
  148.       Scratch[MTitleLen-19] := #0;
  149.     StrCat(Scratch, '...');
  150.   end;
  151.     StrCopy(Title, 'File Clerk - [');
  152.     StrCat(Title, Scratch);
  153.     StrCat(Title, ']');
  154.   SetWindowText(HWindow, Title);
  155.     FCFilterEdit^.SetText(StrLower(PTranRec^.EFltr));
  156.   StrCopy(ShortApp, StrLower(PTranRec^.EApp));
  157.   if StrLen(ShortApp) > 30 then
  158.   begin
  159.       StrCopy(Scratch, PTranRec^.EApp);
  160.     repeat
  161.         Scratch[0] := ' ';
  162.         P := StrScan(Scratch, '\');
  163.       L := StrLen(P);
  164.       StrMove(Scratch, P, L+1);
  165.     until L < 25;
  166.         StrLCopy(ShortApp, PTranRec^.EApp, 3);
  167.     StrCat(ShortApp, '...');
  168.     StrCat(ShortApp, Scratch);
  169.   end;
  170.     FCAppLabel^.SetText(ShortApp);
  171.     FCDirLabel^.SetText(StrLower(PTranRec^.EDir));
  172.     StrCopy(Choice, PTranRec^.EDir);
  173.     if Choice[3] = #0 then Choice[2] := #0;
  174.     StrCat(Choice, '\');
  175.     StrCat(Choice, PTranRec^.EFltr);
  176.     DlgDirList(HWindow, Choice, id_FCFileList, id_FCDirLabel, $4010);
  177. end;
  178.  
  179. procedure FCDlg.clickFCFileList(var Msg: TMessage);
  180. begin
  181.     if Msg.LParamHi = lbn_DblClk then
  182.         FCDlg.Ok(Msg);
  183. end;
  184.  
  185. procedure FCDlg.Launch;
  186. var
  187.     ACommandLine: array[0..144] of Char;
  188.     OldCursor: HCursor;
  189.   State: Word;
  190. begin
  191.     OldCursor := SetCursor(LoadCursor(0, idc_Wait));
  192.     if PTranRec^.RFull = bf_Checked then State := sw_ShowMaximized;
  193.     if PTranRec^.RWin = bf_Checked then State := sw_ShowNormal;
  194.     if PTranRec^.RMin = bf_Checked then State := sw_ShowMinimized;
  195.     if PTranRec^.CNeedsApp = bf_UnChecked then
  196.     begin
  197.       StrCat(Choice, ' ');
  198.     StrCat(Choice, PTranRec^.EPrm);
  199.         WinExec(Choice, State);
  200.     end
  201.     else
  202.     begin
  203.         StrCopy(ACommandLine, PTranRec^.EApp);
  204.         StrCat(ACommandLine, ' ');
  205.     StrCat(ACommandLine, PTranRec^.EPrm);
  206.     StrCat(ACommandLine, ' ');
  207.         StrCat(ACommandLine, Choice);
  208.         WinExec(ACommandLine, State);
  209.     end;
  210.     SetCursor(OldCursor);
  211. end;
  212.  
  213. procedure FCDlg.Ok(var Msg: TMessage);
  214. var
  215.     Answer: Integer;
  216.     IsDir: Boolean;
  217. begin
  218.     if FCFilterEdit^.IsModified = true then
  219.     begin
  220.         FCFilterEdit^.GetText(PTranRec^.EFltr, fsFileName+fsExtension);
  221.         FileExpand(Choice, PTranRec^.EFltr);
  222.         Update;
  223.         FCFilterEdit^.ClearModify
  224.     end else
  225.     if SendDlgItemMessage(HWindow, id_FCFileList, lb_GetCurSel,
  226.          0, 0) <> lb_Err then
  227.     begin
  228.         IsDir := DlgDirSelect(HWindow, Choice,
  229.             id_FCFileList);
  230.         FileExpand(Choice, Choice);
  231.         if IsDir = true then
  232.         begin
  233.             FCFilterEdit^.GetText(PTranRec^.EFltr, fsFileName+fsExtension);
  234.             StrCat(Choice, PTranRec^.EFltr);
  235.             DlgDirList(HWindow, Choice, id_FCFileList, id_FCDirLabel, $4010);
  236.         end
  237.         else
  238.         begin
  239.             Launch;
  240.             Cancel(Msg);
  241.         end;
  242.     end;
  243. end;
  244.  
  245. procedure FCDlg.CMSelect(var Msg: TMessage);
  246. var
  247.     PD: PDialog;
  248. begin
  249.     PD := New(PSctnDlg, Init(@Self, SectionName, Sizeof(SectionName)-1));
  250.   if Application^.ExecDialog(PD) = id_Ok then
  251.   begin
  252.       GetIniData(PTranRec, SectionName);
  253.       Update;
  254.   end;
  255. end;
  256.  
  257.  
  258. procedure FCDlg.CMEdit(var Msg: TMessage);
  259. var
  260.     PD: PDialog;
  261. begin
  262.     PD := New(PFCSDlg, Init(@Self, SectionName));
  263.     PD^.TransferBuffer := PTranRec;
  264.   if Application^.ExecDialog(PD) = id_Ok then Update;
  265. end;
  266.  
  267. procedure FCDlg.CMQuit(var Msg: TMessage);
  268. begin
  269.     FCDlg.Done;
  270. end;
  271.  
  272. procedure FCDlg.CMHelpIndex(var Msg: TMessage);
  273. begin
  274.     WinHelp(HWindow, FCHelpFile, HELP_INDEX, LongInt(NIL));
  275. end;
  276.  
  277. procedure FCDlg.CMHelpTutorial(var Msg: TMessage);
  278. begin
  279.     WinHelp(HWindow, FCHelpFile, HELP_CONTEXT, LongInt(TutorialHelp));
  280. end;
  281.  
  282. procedure FCDlg.CMHelpAbout(var Msg: TMessage);
  283. var
  284.     Dialog: TDialog;
  285. begin
  286.     Dialog.Init(@Self, PChar(id_AboutDlg));
  287.     Dialog.Execute;
  288.   Dialog.Done
  289. end;
  290.  
  291.  
  292. { Main application loop }
  293. var
  294.     FCApp: FCApplication;
  295. begin
  296.     FCApp.Init('FC');
  297.     FCApp.Run;
  298.     FCApp.Done
  299. end.
  300.